home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2006 October
/
PCWorld_2006-10_cd.bin
/
audio-video
/
mediamonkey
/
MediaMonkey_2[1].5.4.977.exe
/
{app}
/
Scripts
/
Export.vbs
< prev
next >
Wrap
Text File
|
2005-06-21
|
16KB
|
560 lines
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' This file can be replaced in one of the future versions,
' so please if you want to modify it, make a copy, do your
' modifications in that copy and change Scripts.ini file
' appropriately.
' If you do not do this, you will lose all your changes in
' this script when you install a new version of MediaMonkey
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Option Explicit ' report undefined variables, ...
' function for quoting strings
Function QStr( astr)
QStr = chr(34) & astr & chr(34)
End Function
' function for quoting strings converted to plain ASCII
Function QAStr( astr)
QAStr = chr(34) & SDB.toASCII(astr) & chr(34)
End Function
Dim list ' list of songs to be exported
Dim res ' results of dialogs calls
Dim fullfile ' fully specified output file name
Dim fso ' FileSystemObject
' SDB variable is connected to MediaMonkey application object
Sub InitExport( ext, filter, iniDirValue)
fullfile = ""
' Get a list of songs to be exported
Set list = SDB.CurrentSongList
If list.count=0 Then
res = SDB.MessageBox( SDB.Localize("Select tracks to be exported, please."), mtError, Array(mbOk))
Exit Sub
End If
' Open inifile and get last used directory
Dim iniF
Set iniF = SDB.IniFile
' Create common dialog and ask where to save the file
Dim dlg
Set dlg = SDB.CommonDialog
dlg.DefaultExt=ext
dlg.Filter=filter
dlg.Flags=cdlOFNOverwritePrompt + cdlOFNHideReadOnly + cdlOFNNoChangeDir
dlg.InitDir = iniF.StringValue( "Scripts", iniDirValue)
dlg.ShowSave
if Not dlg.Ok Then
Exit Sub ' if cancel was pressed, exit
End If
' Get the selected filename
fullfile = dlg.FileName
' Connect to the FileSystemObject
Set fso = SDB.Tools.FileSystem
' Write selected directory to the ini file
iniF.StringValue( "Scripts", iniDirValue) = fullfile
End Sub
Sub FinishExport( ok)
On Error Resume Next
' remove the output file if terminated
if not Ok then
fso.DeleteFile( fullfile)
end if
End Sub
Sub ExportCSV
' initialize export
Call InitExport (".csv", "CSV (*.csv)|*.csv|All files (*.*)|*.*", _
"LastExportCSVDir")
if fullfile="" then
Exit Sub
end if
' Create the output file
Dim fout
Set fout = fso.CreateTextFile( fullfile, True)
' Write header line
fout.WriteLine Join(Array(SDB.Localize("Artist"),SDB.Localize("Title"), _
SDB.Localize("Album"),SDB.Localize("Length"),SDB.Localize("Year"), _
SDB.Localize("Genre"),SDB.Localize("Rating"),SDB.Localize("Bitrate"), _
SDB.Localize("Path"),SDB.Localize("Media")),",")
' Use progress to notify user about the current action
Dim Progress
Set Progress = SDB.Progress
Progress.Text = SDB.Localize("Exporting...")
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
for i=0 to list.count-1
Set itm = list.Item(i)
Dim bitrate
bitrate = itm.bitrate
if bitrate>0 then
bitrate = CStr(Round( bitrate/1000))
else
bitrate = ""
end if
fout.WriteLine Join( Array( QAStr(itm.ArtistName), QAStr(itm.title), QAStr(itm.AlbumName), _
QAStr(itm.SongLengthString), CStr(itm.Year), QAStr(itm.Genre), CStr(itm.Rating), CStr(bitrate), _
QAStr(itm.Path), QAStr(itm.MediaLabel)), ",")
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
' Close the output file and finish
fout.Close
' Was it successfull?
Dim ok
if Progress.Terminate then
ok = False
else
ok = True
end if
' hide progress
Set Progress = Nothing
Call FinishExport( ok)
End Sub
' escape XML string
Function MapXML( srcstring)
srcstring = Replace( srcstring, "&", "&")
srcstring = Replace( srcstring, "<", "<")
srcstring = Replace( srcstring, ">", ">")
Dim i
i=1
While i<=Len(srcstring)
If (AscW(Mid(srcstring, i, 1))>127) Then
srcstring = Mid( srcstring, 1, i-1)+""+CStr( AscW( Mid( srcstring, i, 1)))+";"+Mid( srcstring, i+1, Len(srcstring))
End If
i=i+1
WEnd
MapXML = srcstring
End Function
Sub ExportHTML
' initialize export
Call InitExport( ".htm", "HTML (*.htm)|*.htm|All files (*.*)|*.*", _
"LastExportHTMLDir")
if fullfile="" then
Exit Sub
end if
' Create the output file
Dim fout
Set fout = fso.CreateTextFile( fullfile, True)
' Write header line
fout.WriteLine "<html>"
fout.WriteLine "<head><title>" & SDB.Localize("MediaMonkey Track List") & "</title>"
' Code to format the document
fout.WriteLine "<style type=text/css>"
fout.WriteLine "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}"
fout.WriteLine "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-aligh:left}"
fout.WriteLine "P{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000;}"
fout.WriteLine "TH{font-family:'Verdana',sans-serif; font-size:10pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}"
fout.WriteLine "TD{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}"
fout.Writeline "TD.dark{background-color:#EEEEEE}"
fout.WriteLine "</style>"
fout.WriteLine "</head><body>"
fout.WriteLine "<a href='http://www.mediamonkey.com'><h1>" & SDB.Localize("MediaMonkey Track List")&"</h1></a>"
' Headers of table
fout.WriteLine "<table cellpadding=4 cellspacing=0>"
fout.WriteLine "<tr align=left>"
fout.WriteLine " <th id=dark>#</th>"
fout.WriteLine " <th>" & SDB.Localize("Artist") & "</th>"
fout.WriteLine " <th id=dark>" & SDB.Localize("Title") & "</th>"
fout.WriteLine " <th>" & SDB.Localize("Length") & "</th>"
fout.WriteLine " <th id=dark>" & SDB.Localize("Album") & "</th>"
fout.WriteLine " <th>" & SDB.Localize("Track #") & "</th>"
fout.WriteLine " <th id=dark>" & SDB.Localize("Year") & "</th>"
fout.WriteLine " <th>" & SDB.Localize("Genre") & "</th>"
fout.WriteLine " <th id=dark>" & SDB.Localize("Rating") & "</th>"
fout.WriteLine " <th>" & SDB.Localize("Bitrate") & "</th>"
fout.WriteLine " <th id=dark>" & SDB.Localize("Media") & "</th>"
fout.WriteLine "</tr>"
' Use progress to notify user about the current action
Dim Progress
Set Progress = SDB.Progress
Progress.Text = SDB.Localize("Exporting...")
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
for i=0 to list.count-1
Set itm = list.Item(i)
Dim bitrate
bitrate = itm.bitrate
if bitrate>0 then
bitrate = CStr(Round( bitrate/1000))
else
bitrate = " "
end if
Dim year
year = itm.year
if year<=0 then
year = " "
else
year = CStr( year)
end if
' Add space to empty fields, so table is displayed correctly (Cell borders do not show up for empty cells)
Dim artistname
artistname = MapXML(itm.ArtistName)
if artistname="" then
artistname = " "
end if
Dim songtitle
songtitle = MapXML(itm.title)
if songtitle="" then
songtitle = " "
end if
Dim albumname
albumname = MapXML(itm.AlbumName)
if albumname="" then
albumname = " "
end if
Dim songlength
songlength = itm.SongLengthString
if songlength="" then
songlength = " "
end if
Dim songgenre
songgenre = MapXML(itm.Genre)
if songgenre="" then
songgenre = " "
end if
Dim trackorder
trackorder = itm.TrackOrder
if trackorder="" then
trackorder = " "
elseif trackorder = "0" then
trackorder = " "
end if
' These are added to get some decent display, all the others haven't, this script is just to demonstrate all the available options
Dim rating
Dim ratingCal
rating = itm.Rating
Select Case rating
Case ""
ratingCal = " "
Case -1
ratingCal = " "
Case 100
ratingCal = 5
Case 90
ratingCal = 4.5
Case 80
ratingCal = 4
Case 70
ratingCal = 3.5
Case 60
ratingCal = 3
Case 50
ratingCal = 2.5
Case 40
ratingCal = 2
Case 30
ratingCal = 1.5
Case 20
ratingCal = 1
Case 10
ratingCal = 0.5
Case 0
ratingCal = 0
Case Else
ratingCal = " "
End Select
Dim medialabel
medialabel = MapXML(itm.MediaLabel)
if medialabel="" then
medialabel = " "
end if
' Body of the table
fout.WriteLine "<tr><td align=right class=dark>"&i+1&"</td><td>"&artistname&"</td><td class=dark>"&songtitle _
&"</td><td align=right>"&songlength&"</td><td class=dark>"&albumname _
&"</td><td align=right>"&trackorder&"</td><td align=right class=dark>"&Year _
&"</td><td>"&songgenre&"</td><td class=Dark>"&ratingCal&"</td><td align=right>"&bitrate _
&"</td><td align=right class=Dark>"&medialabel&"</td></tr>"
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
' Write some code to finish html document
fout.WriteLine "</table><p/><table width=100%><tr>"
fout.WriteLine "<td style='border-bottom-width:0px'><b>"&SDB.Localize("Total Tracks:")&" </b>"&i&"</td> <td align=right style='border-bottom-width:0px'>Generated by <a href='http://www.mediamonkey.com'>MediaMonkey</a></td>"
fout.WriteLine "</tr></table></body></html>"
' Close the output file and finish
fout.Close
' Was it successfull?
Dim ok
if Progress.Terminate then
ok = False
else
ok = True
end if
' hide progress
Set Progress = Nothing
FinishExport( ok)
End Sub
Sub ExportXLS
' initialize export
Call InitExport( ".xls", "Excel sheet (*.xls)|*.xls|All files (*.*)|*.*", _
"LastExportExcelDir")
if fullfile="" then
Exit Sub
end if
if fso.FileExists( fullfile) then
fso.DeleteFile( fullfile)
end if
On Error Resume Next
' Connect to Excel
Dim Excel, WB, WS
Set Excel = CreateObject("Excel.application")
If Err.Number<>0 then
MsgBox "Microsoft Excel could not be found, please install it and try again."
Err.Clear
Exit Sub
End If
On Error GoTo 0
' Create a new workbook and get its worksheet
Set WB = Excel.WorkBooks.Add
Set WS = WB.Sheets(1)
' Use progress to notify user about the current action
Dim Progress
Set Progress = SDB.Progress
Progress.Text = SDB.Localize("Exporting...")
' Create a header
WS.Cells(1,1).Value = SDB.Localize("Artist")
WS.Cells(1,2).Value = SDB.Localize("Album")
WS.Cells(1,3).Value = SDB.Localize("Title")
WS.Cells(1,4).Value = SDB.Localize("Length")
WS.Cells(1,5).Value = SDB.Localize("Year")
WS.Cells(1,6).Value = SDB.Localize("Genre")
WS.Cells(1,7).Value = SDB.Localize("Bitrate")
WS.Cells(1,8).Value = SDB.Localize("Media")
WS.Rows("1:1").Font.Bold = True
Dim ms2Day
ms2Day = 24*60*60*1000
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
for i=0 to list.count-1
Set itm = list.Item(i)
Dim bitrate
bitrate = itm.bitrate
if bitrate>0 then
bitrate = CStr(Round( bitrate/1000))
else
bitrate = ""
end if
Dim year
year = itm.year
if year<=0 then
year = ""
else
year = CStr( year)
end if
WS.Cells(i+2,1).Value = itm.ArtistName
WS.Cells(i+2,2).Value = itm.AlbumName
WS.Cells(i+2,3).Value = itm.title
WS.Cells(i+2,4).NumberFormat = "mm:ss"
If itm.SongLength>=0 Then
WS.Cells(i+2,4).Value = itm.SongLength / ms2Day
End If
WS.Cells(i+2,5).Value = year
WS.Cells(i+2,6).Value = itm.Genre
WS.Cells(i+2,7).Value = bitrate
WS.Cells(i+2,8).Value = itm.MediaLabel
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
' Was it successfull?
Dim ok
if Progress.Terminate then
ok = False
else
ok = True
WB.SaveAs fullfile
end if
WB.Close false
' hide progress
Set Progress = Nothing
FinishExport( ok)
End Sub
Sub ExportXML
' initialize export
Call InitExport (".xml", "XML (*.xml)|*.xml|All files (*.*)|*.*", _
"LastExportXMLDir")
if fullfile="" then
Exit Sub
end if
' Create the output file
Dim fout
Set fout = fso.CreateTextFile( fullfile, True)
' Use progress to notify user about the current action
Dim Progress
Set Progress = SDB.Progress
Dim ProgressString
ProgressString = SDB.Localize("Exporting...")
Dim i
Dim Artists, Artist
Set Artists = list.Artists
Dim Albums, Album
Set Albums = list.Albums
fout.WriteLine "<?xml version='1.0'?>"
fout.WriteLine "<MusicDatabase>"
Progress.MaxValue = list.count + Artists.Count + Albums.Count
Progress.Text = ProgressString & " (artists)"
fout.WriteLine " <Artists>"
for i=0 to Artists.count-1
Set Artist = Artists.Item(i)
fout.WriteLine " <Artist id=""Artist_"&Artist.id&""">"
fout.WriteLine " <Name>" & MapXML(Artist.Name) & "</Name>"
fout.WriteLine " </Artist>"
Progress.Increase
if Progress.Terminate then
Exit For
end if
next
fout.WriteLine " </Artists>"
Progress.Text = ProgressString & " (albums)"
fout.WriteLine " <Albums>"
for i=0 to Albums.count-1
Set Album = Albums.Item(i)
fout.WriteLine " <Album id=""Album_"&Album.id&""">"
fout.WriteLine " <PerformingArtist id="""& Album.Artist.id & """>" & MapXML(Album.Artist.Name) & "</PerformingArtist>"
fout.WriteLine " <Name>" & MapXML(Album.Name) & "</Name>"
fout.WriteLine " </Album>"
Progress.Increase
if Progress.Terminate then
Exit For
end if
next
fout.WriteLine " </Albums>"
' Iterate through the list and export all songs
Progress.Text = ProgressString & " (songs)"
fout.WriteLine " <Songs>"
Progress.MaxValue = list.count
Dim Song, Media
for i=0 to list.count-1
Set Song = list.Item(i)
fout.WriteLine " <Song id=""Song_"&Song.id&""">"
fout.WriteLine " <Title>" & MapXML(Song.Title) & "</Title>"
fout.WriteLine " <PerformingArtist id=""Artist_"& Song.Artist.id & """>" & MapXML(Song.ArtistName) & "</PerformingArtist>"
fout.WriteLine " <ContainedInAlbum id=""Album_"& Song.Album.id & """>" & MapXML(Song.AlbumName) & "</ContainedInAlbum>"
fout.WriteLine " <SongLength ms="""& Song.SongLength &""">" & MapXML(Song.SongLengthString) & "</SongLength>"
if Song.Year>0 then
fout.WriteLine " <Year value="""& MapXML(Song.Year) &"""/>"
end if
if Song.Genre<>"" then
fout.WriteLine " <Genre>"& MapXML(Song.Genre) &"</Genre>"
end if
fout.WriteLine " <Bitrate>"& MapXML(Song.Bitrate) &"</Bitrate>"
fout.WriteLine " <Location>"
Set Media = Song.Media
If Not IsNull( Media) And Not IsEmpty( Media) And IsObject( Media) Then
fout.WriteLine " <Media id=""Media_"&Media.id&""" sn=""" & _
Media.SerialNumber & """>"& MapXML(Media.MediaLabel) &"</Media>"
End If
fout.WriteLine " <Path>"& MapXML(Song.Path) &"</Path>"
fout.WriteLine " </Location>"
fout.WriteLine " </Song>"
Progress.Increase
if Progress.Terminate then
Exit For
end if
next
fout.WriteLine " </Songs>"
fout.WriteLine "</MusicDatabase>"
' Close the output file and finish
fout.Close
' Was it successfull?
Dim ok
if Progress.Terminate then
ok = False
else
ok = True
end if
' hide progress
Set Progress = Nothing
Call FinishExport( ok)
End Sub